home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / strew.arc / STREW.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-09-30  |  29.4 KB  |  561 lines
  1. 2 CLS:KEY OFF:LOCATE 1,30:PRINT "FILE STREWER":LOCATE 2,26:PRINT "ver 1.1  Sept 2, 1984"
  2. 3 LOCATE 4,3:PRINT "Copyright (c) 1984  Ken Goosens, 5020 Portsmouth Road, Fairfax, VA 22032"
  3. 4 LOCATE 7,2:PRINT "You are granted a limited license to use and distribute this program provided"
  4. 5 LOCATE 9,15:PRINT "1.  you do not alter or remove this notice"
  5. 6 LOCATE 11,15:PRINT "2.  you receive no fee or charge for this program"
  6. 10 CLEAR:DEFINT A-Z:ON ERROR GOTO 10000
  7. 11 DEF FNNSTR$(X)=MID$(STR$(X),2)
  8. 12 DEF FNSECONDs! = (val(mid$(time$,4,2))*60+val(mid$(time$,7,2)))
  9. 14 PAUSE! = 4:GOSUB 3000:ONE=1
  10. 17 DEF SEG = &H1700:QPRINT=0:BLOAD "QPRINT.BIN",QPRINT 'Comment out when compiling
  11. 20 NUL$="":EDCHR$=NUL$:SECHR$=NUL$:READ IX,JX:EDCHR$=SPACE$(IX):SECHR$=SPACE$(JX)
  12. 25 MAXDIM=99:DIM MAX(99),LO(99),HI(99),STRT(99),EFLDS(99),FIRSTFLD(99),FLD2SCRN(99)
  13. 30 DIM RCOL(99),RLEN(99),RORDER(99),CTITLE$(99),NQUO(99),WORDER(99),USED$(99),TEMP(99)
  14. 40 FOR I=1 TO IX:READ J:MID$(EDCHR$,I,1)=CHR$(J):NEXT
  15. 50 FOR I=1 TO JX:READ J:MID$(SECHR$,I,1)=CHR$(J):NEXT
  16. 52 NORBBS=-1:CONSTREW$=NUL$:MXE=0:TOEDIT$=NUL$
  17. 55 MMENU$="R)bbs...S)trew...C)onfigure...Q)uit            "
  18. 60 REM == IN NEXT STATEMENT PUT NUMBER OF EDIT CHARS OF LEN=1, LEN=2
  19. 70 DATA 5,12
  20. 80 ' NULL,ESC,C/R,BACKSPACE,TAB
  21. 90 DATA 0,27,13,8,9
  22. 100 ' INS,DEL,PGDN,PGUP,LEFT,RIGHT,UP,DOWN,END,HOME,ALT-D,ALT-V
  23. 110 DATA 82,83,81,73,75,77,72,80,79,71,32,47
  24. 120 DIGITS$="0123456789"
  25. 130 DIM DIRH$(99) 'array of directory help
  26. 140 NPARMS = 11:FLIP = -1
  27. 145 zz$=space$(63):hd1$=zz$:hd2$=zz$:ft$=zz$
  28. 150 Q$ = CHR$(34):QCQ$= Q$+","+Q$:LF$=CHR$(10)
  29. 155 CR$=CHR$(13):WL=255:USED$(1)=string$(255,chr$(0))
  30. 160 FIRSTROW = 4 'reserve top two lines for status:3rd for header
  31. 280 SP$=" ":MID$(MMENU$,37)="([R],S,C,Q)":DEFLT$="R"
  32. 285 MAXMAX=1800:DIM E$(1800):CLS 'hard coded so will compile. for Interpreter, can use x
  33. 290 DEF FNE(R,C)=((R-1)*MAXFIELDS+C)
  34. 292 ' GOSUB 9000 ' CHECK FOR DOS PARM - INCLUDE ONLY IF COMPILING
  35. 295 IF A$<>NUL$ THEN SWAP A$,PARM$:IF PARM$="RBBS" THEN X=1:PARM$=NUL$:GOTO 320 ELSE X=2:GOTO 320
  36. 300 CLS:LSET ZZ$=MMENU$:RO=1:GOSUB 860:LOCATE RO,49:INPUT "",A$:IF A$=NUL$ THEN A$=DEFLT$ ELSE GOSUB 8000
  37. 310 X=INSTR("RSCQ",A$):IF INSTR("Qq",DEFLT$) AND INSTR("Q",A$)=0 THEN DEFLT$="R":MID$(MMENU$,37)="([R],S,C,Q)"
  38. 320 ON X GOTO 360,4000,2130,330:BEEP:GOTO 300
  39. 330 CLS:SYSTEM
  40. 335 LSET ZZ$="Press ESCAPE key when done...":RO=1:GOSUB 860:RETURN
  41. 340 LSET ZZ$="Press ESCAPE key when done... ALT-D for directory help":RO=1:GOSUB 860:RETURN
  42. 350 FOR I=2 TO MAXFIELDS:STRT(I)=STRT(I-1)+MAX(I-1)+2:NEXT:RETURN
  43. 360 IF NORBBS THEN GOSUB 3200 'RBBS edit routine
  44. 390 WHSTREW = 1:MINMPP=1
  45. 394 MAXFIELDS = 5:GOSUB 8100
  46. 398 MOREITEMS = -1
  47. 402 LO(1)=32:LO(2)=32:LO(3)=44:LO(4)=31
  48. 406 HI(1)=58:HI(2)=127:HI(3)=58:HI(4)=127
  49. 410 MAX(1)=LSTREW:MAX(2)=12:MAX(3)=8
  50. 420 CTITLE$(1)=MID$("STREW TO",1,MAX(1)):CTITLE$(2)="  FILENAME":CTITLE$(3)="  DATE":CTITLE$(4)="  DESCRIPTION"
  51. 430 STRT(1)=0:GOSUB 350:MAX(4)=79-STRT(4)
  52. 440 IF EDFILE THEN MAXEDIT=MAXFIELDS-1:FOR I=1 TO MAXEDIT:EFLDS(I)=I:NEXT ELSE MAXEDIT = MAXFIELDS-2:EFLDS(1)=1:EFLDS(2)=3:EFLDS(3)=4
  53. 460 FOR I=1 TO MAXFIELDS:FLD2SCRN(I)=1:NEXT
  54. 480 LASTSCRN=1:FIRSTFLD(1)=1
  55. 490 FIRSTFLD(LASTSCRN+1)=MAXFIELDS
  56. 500 MINLEN = 32
  57. 510 NREADS = 0
  58. 520 BADLN = 0
  59. 540 IF TOEDIT$=NUL$ THEN LSET ZZ$="File to edit: ":RO=1:GOSUB 860:LOCATE RO,15:INPUT A$:if A$=nul$ then 300 else GOSUB 8000:SWAP A$,TOEDIT$
  60. 550 IF MID$(TOEDIT$,2,1)<>":" THEN TOEDIT$ = DR$+":"+TOEDIT$
  61. 560 OPEN TOEDIT$ FOR INPUT AS #2
  62. 565 OPEN BADFILE$ FOR OUTPUT AS #3:GOSUB 630
  63. 570 GOSUB 340:GOSUB 910
  64. 580 LSET ZZ$="S)trew...A)bort...E)dit again...([S],A,E)":RO=1:GOSUB 860:LOCATE RO,43:INPUT "",A$:GOSUB 8000
  65. 590 ON INSTR("SAE",A$) GOTO 600,300,570
  66. 600 GOSUB 1790:IF NOT MOREITEMS THEN 620
  67. 610 GOSUB 630:IF NUMENT<1 THEN 620 ELSE 570
  68. 620 MID$(MMENU$,37)="(R,S,C,[Q])":DEFLT$="Q":GOTO 300
  69. 630 PREVSCRN=0:PREVPAGE=0 'routine to READ in items
  70. 640 GOSUB 4700
  71. 670 IF EOF(2) THEN CLOSE 2:CLOSE 3:MOREITEMS=0:LSET ZZ$="ALL"+STR$(NREADS)+" lines in "+TOEDIT$+" read. "+STR$(BADLN)+" non-directory lines skipped.":RO=25:GOSUB 860:GOTO 820
  72. 680   IF NUMENT >= MAXENTRIES THEN LSET ZZ$="NOT ALL items have been read from "+TOEDIT$:RO=25:GOSUB 860:GOTO 820
  73. 690   LINE INPUT #2,LN$:NREADS=NREADS+1:LOCATE 12,32:PRINT NREADS;
  74. 700   IF MID$(LN$,22,2)<>"  " OR MID$(LN$,13,1)<>SP$ OR LEN(LN$)<MINLEN THEN PRINT #3,LN$:BADLN=BADLN+1:GOTO 670
  75. 710   NUMENT = NUMENT + 1
  76. 720   IF MID$(LN$,21,1)=SP$ THEN MID$(LN$,14,8)=SP$+MID$(LN$,14,7)
  77. 730   IF MID$(LN$,24,1)=SP$ THEN MID$(LN$,24)=MID$(LN$,25)+SP$
  78. 740   L=LEN(LN$)
  79. 750   IF MID$(LN$,L,1)=SP$ THEN L=L-1:GOTO 750 ELSE IF L<33 THEN L=33
  80. 760   W=FNE(NUMENT,1):E$(W)=D$ 'default directories
  81. 770   E$(W+1)=mid$(LN$,1,12) ' file name
  82. 780   E$(W+2)=MID$(LN$,24,8) ' date uploaded
  83. 790   E$(W+3)=MID$(LN$,34,L-33) ' description
  84. 800   E$(W+4)=MID$(LN$,14,8) ' file size
  85. 810 GOTO 670
  86. 820 IF MAXPERPAGE<1 THEN LASTPAGE=1:GOTO 840
  87. 825 LASTPAGE = NUMENT \ MAXPERPAGE
  88. 830 IF  NUMENT MOD MAXPERPAGE THEN LASTPAGE = LASTPAGE+1
  89. 840 R=FIRSTROW:FLD=EFLDS(1):FLDR=FLD:START=STRT(FLD):PO=1:CURRPAGE=1:CURRSCRN=1:IF LASTPAGE=1 THEN LASTROW=FIRSTROW+NUMENT-1 ELSE LASTROW=FIRSTROW+MAXPERPAGE-1
  90. 850 GOSUB 1650:RETURN
  91. 860 CALL QPRINT (ZZ$,RO,ONE)
  92. 870 IF RO=1 THEN LSET HD1$=ZZ$ ELSE IF RO=2 THEN LSET HD2$=ZZ$ ELSE IF RO=25 THEN LSET FT$=ZZ$
  93. 880 RETURN
  94. 890 'edit routine
  95. 900 BEEP 'entry if bad
  96. 910 'entry if got change
  97. 920 LOCATE R,START+PO,1,6,7 'entry if changing only cursor
  98. 930 X$=INKEY$:IF X$=NUL$ THEN 930
  99. 940 X1$=MID$(X$,1,1):X2$=MID$(X$,2,1)
  100. 950 A1=ASC(X1$):IF LEN(X2$)<1 THEN A2 = 0 ELSE A2=ASC(X2$)
  101. 960 'LOCATE 24,40:PRINT "A1=";A1;" A2=";A2,:LOCATE R,START+PO
  102. 980 ON INSTR(EDCHR$,X1$) GOTO 1120,1740,1010,1090,1110
  103. 985 IF A1>LO(FLD) AND A1<HI(FLD) THEN 1600 ELSE 900
  104. 990 FLDR=X:FLD=EFLDS(FLDR):START=STRT(FLD):X=FLD2SCRN(FLD):IF CURRSCRN=X THEN NEWSCRN=0 ELSE NEWSCRN=-1:CURRSCRN=X
  105. 1000 RETURN
  106. 1010 FLDCHANGE = 1  'C/R = next field
  107. 1020 X = FLDR + FLDCHANGE:PO = 1
  108. 1030 IF X >= 1 THEN 1050 ELSE X=MAXEDIT:GOSUB 990:IF NEWSCRN AND LASTSCRN>1 THEN GOSUB 1650
  109. 1040 GOTO 1310 'back a row
  110. 1050 IF X <= MAXEDIT THEN 1070 ELSE X=1:GOSUB 990: IF NEWSCRN AND LASTSCRN>1 THEN GOSUB 1650
  111. 1060 GOTO 1360 'forward a row
  112. 1070 GOSUB 990:IF NEWSCRN THEN GOSUB 1650:GOTO 910 ELSE 910
  113. 1080 FLDCHANGE = -1:GOTO 1020  'Back a field
  114. 1090 IF PO<2 THEN 900  'BACKSP= delete to left
  115. 1100 PO = PO - 1:GOTO 1150 'same as move left, del at cursor
  116. 1110 PO=1:IF START<STRT(EFLDS(MAXEDIT)) THEN FLDCHANGE=MAXEDIT-FLDR:GOTO 1020 ELSE  1010 'tab
  117. 1120 ON INSTR(SECHR$,X2$) GOTO 1130,1150,1160,1230,1250,1300,1310,1360,1370,1390,1490,1400:GOTO 900
  118. 1130 INSERTING = NOT INSERTING:LOCATE 24,1:IF INSERTING THEN PRINT "Insert "; ELSE PRINT "Replace";
  119. 1140 GOTO 910
  120. 1150 W=FNE(ELEFAC+R,FLD):E$(W)=MID$(E$(W),1,PO-1)+MID$(E$(W),PO+1):GOSUB 1640:GOTO 910 'delete at cursor
  121. 1160 FLIP=0 'PgDn
  122. 1170 PAGECHANGE = 1
  123. 1180 PREV=CURRPAGE:CURRPAGE = ((CURRPAGE-1+LASTPAGE+PAGECHANGE) MOD LASTPAGE) + 1:IF PREV=CURRPAGE THEN 1220
  124. 1190 IF CURRPAGE<>LASTPAGE THEN LASTROW = FIRSTROW + MAXPERPAGE - 1 ELSE LASTROW = FIRSTROW + ((NUMENT-1) MOD MAXPERPAGE)
  125. 1200 IF FLIP THEN IF R=FIRSTROW THEN R=LASTROW ELSE R=FIRSTROW ELSE IF R>LASTROW THEN R=LASTROW
  126. 1210 GOSUB 1650
  127. 1220 FLIP=-1:GOTO 910
  128. 1230 FLIP = 0 'PgUp
  129. 1240 PAGECHANGE = -1:GOTO 1180 
  130. 1250 COLCHANGE = -1 'left arrow
  131. 1260 X = PO + COLCHANGE
  132. 1270 IF X<1 THEN 1080
  133. 1280 IF X>MAX(FLD) THEN 1010
  134. 1290 PO = X:GOTO 910
  135. 1300 IF PO>LEN(E$(FNE(ELEFAC+R,FLD))) THEN 1010 ELSE COLCHANGE = 1:GOTO 1260 'right arrow
  136. 1310 ROWCHANGE = -1 'up arrow=BACK a row
  137. 1320 X = R + ROWCHANGE
  138. 1330 IF X<FIRSTROW THEN 1240 'PgUp
  139. 1340 IF X>LASTROW THEN 1170 'PgDn
  140. 1350 R=X:PO=1:GOTO 910
  141. 1360 ROWCHANGE = 1:GOTO 1320 'down arrow=FORWARD a row
  142. 1370 X = LEN(E$(FNE(ELEFAC+R,FLD)))+1:IF X>MAX(FLD) THEN X=MAX(FLD) 'end=far right field
  143. 1380 COLCHANGE = X-PO:GOTO 1260
  144. 1390 R=FIRSTROW:START=STRT(1):FLD=EFLDS(1):PO=1:GOTO 910 'home=left corner
  145. 1400 ' alt-V = view current file
  146. 1410 ZDR$=UPDR$:ZF$=E$(FNE(ELEFAC+R,2)):GOSUB 2100:IF NOT FILEFOUND THEN CLS:LOCATE 10,20:PRINT "File ";ZF$;" not found":GOTO 1470
  147. 1420 X=0:LSET ZZ$="Contents of "+ZF$:RO=1:A$=SPACE$(1)
  148. 1425 CLOSE 3:OPEN "R",#3,ZF$,255:FIELD #3, WL AS A$:GOSUB 1462
  149. 1427 X#=LOF(3):XT#=X#/255#+1.0#
  150. 1430 X=X+1:IF X>XT# THEN 1470 ELSE GET #3,X
  151. 1442   PL=1
  152. 1444   IF PL>WL THEN 1430 ELSE LL=INSTR(PL,A$,CR$):IF LL AND LL<PL+80 THEN 1446 ELSE 1450
  153. 1446     EN=LL-PL:GOSUB 1466:PRINT
  154. 1448     PL=LL+2:GOTO 1454
  155. 1450     LX=LEN(MID$(A$,PL)):IF LX>80 THEN EN=80 ELSE EN=LX
  156. 1452     GOSUB 1466:PL=PL+EN
  157. 1454     IF CSRLIN>20 THEN GOSUB 1464:IF NO THEN  1470 ELSE GOSUB 1462
  158. 1460   GOTO 1444
  159. 1462   CLS:GOSUB 860:LOCATE 3,1:RETURN
  160. 1464   LOCATE 24,1:INPUT "More ([Y],N) ",AX$:IF INSTR("YyNn",AX$)>2 THEN NO=-1:YES=0
  161. 1465   RETURN
  162. 1466   YY=81-POS(0):IF EN<=YY THEN PRINT MID$(A$,PL,EN); ELSE PRINT MID$(A$,PL,YY);MID$(A$,YY+PL,EN-YY);
  163. 1467   RETURN
  164. 1470 GOSUB 1590
  165. 1480 CLOSE 3:GOSUB 1660:GOSUB 340:GOTO 920
  166. 1490 ' directory help
  167. 1500 CLS:LOCATE 1,30:PRINT "DIRECTORY HELP"
  168. 1510 LOCATE 2,30
  169. 1520 FOR I=1 TO 96 STEP 5
  170. 1530    IF I=96 THEN JX=3 ELSE JX=4
  171. 1540    TX=1:FOR J=I TO I+JX
  172. 1550        PRINT TAB(TX):PRINT USING "##";J;:PRINT SP$;DIRH$(J);:TX=TX+16
  173. 1560    NEXT
  174. 1570 NEXT:GOSUB 1590
  175. 1580 PREVPAGE=0:PREVSCRN=0:GOSUB 1650:GOTO 910
  176. 1590 LOCATE 25,1:PRINT "Press any key to continue...";:X$=INPUT$(1):RETURN
  177. 1600 W=FNE(ELEFAC+R,FLD):LL=LEN(E$(W)):IF NOT INSERTING AND PO <= LL THEN MID$(E$(W),PO,1)=X1$:IF PO>=MAX(FLD) THEN 1630 ELSE 1620
  178. 1605 IF PO>=MAX(FLD) THEN E$(W)=MID$(E$(W),1,PO-1)+X1$:GOTO 1630 'CHANGE routine
  179. 1607 IF LL>=MAX(FLD) THEN PR=LL-PO ELSE PR=LL-PO+1
  180. 1610 E$(W)=MID$(E$(W),1,PO-1)+X1$+MID$(E$(W),PO,PR)
  181. 1620 GOSUB 1640:COLCHANGE=1:GOTO 1260
  182. 1630 GOSUB 1640:GOTO 910
  183. 1640 W=FNE(ELEFAC+R,FLD):LL=LEN(E$(W)):LOCATE R,START+1:PRINT E$(W);SPACE$(MAX(FLD)-LL);
  184. 1647 RETURN
  185. 1650 IF MAXPERPAGE<1 THEN RETURN   'prints current page of entries
  186. 1655 IF PREVPAGE = CURRPAGE THEN IF PREVSCRN = CURRSCRN THEN RETURN
  187. 1660 CLS:LOCATE 1,1:PRINT HD1$;:LOCATE 1,64:PRINT "P. ";MID$(STR$(CURRPAGE),2);"/";MID$(STR$(LASTPAGE),2);" S. ";MID$(STR$(CURRSCRN),2);"/";MID$(STR$(LASTSCRN),2)
  188. 1670 LOCATE 2,1:PRINT HD2$;:LOCATE 25,1:PRINT FT$;
  189. 1680 ELEFAC= (CURRPAGE-1)*MAXPERPAGE-FIRSTROW+1
  190. 1690 EX=(CURRPAGE-1)*MAXPERPAGE:X=FIRSTFLD(CURRSCRN):Y=FIRSTFLD(CURRSCRN+1)-1
  191. 1700 FOR J=X TO Y:LOCATE 3,STRT(J)+1:PRINT CTITLE$(J);:NEXT
  192. 1710 FOR I=1 TO LASTROW-FIRSTROW+1:RX=FIRSTROW+I-1
  193. 1720   FOR J=X TO Y:SX=STRT(J)+1:CALL QPRINT (E$(FNE(EX+I,J)),RX,SX):NEXT
  194. 1730 NEXT:PO=1:PREVPAGE=CURRPAGE:PREVSCRN=CURRSCRN:RETURN
  195. 1740 RETURN 'Esc routine
  196. 1750 LSET ZZ$="About to save lines - please confirm Okay ([Y],N)?":RO=1:GOSUB 860:INPUT "",A$:IF INSTR("YyNn",A$)>2 THEN RETURN
  197. 1760 GOSUB 1790:IF NOT MOREITEMS THEN 1780
  198. 1770 GOSUB 630:IF NUMENT<1 THEN 1780 ELSE GOSUB 340:GOTO 910
  199. 1780 RETURN
  200. 1790 CLS:NX=2:LSET USED$(1)=",":NUSED=1 'SAVE routine
  201. 1810 FOR I=1 TO NUMENT ': PRINT "GETTING NUMBER FROM ITEM ";I
  202. 1830   SX=1
  203. 1840   LAS = INSTR(SX,E$(FNE(I,1))+",",",")
  204. 1850   IF LAS<2 THEN 1980 ELSE X=LAS-1
  205. 1855     IF MID$(E$(FNE(I,1)),X,1)=" " THEN X=X-1:GOTO 1855
  206. 1860     A$=MID$(E$(FNE(I,1)),SX,X+1-SX):L=LEN(A$):J=1
  207. 1863     IF INSTR(USED$(J),","+A$+",") THEN 1960
  208. 1865     J=J+1:IF J<= NUSED THEN 1863
  209. 1866     X=NX+L+1:IF X>255 THEN NUSED=NUSED+1:NX=2:USED$(NUSED)=","+SPACE$(254):X=L+2
  210. 1868     MID$(USED$(NUSED),NX,L+1)=A$+",":NX=X
  211. 1870     IF WHSTREW=1 THEN GOSUB 2050:IF NOT NUMERIC THEN 1960
  212. 1880     F$=PRE$+A$ ':PRINT "From item";i;" SEARCHING FOR ";A$;" SX=";SX;" LAS=";LAS
  213. 1900     OPEN F$ FOR APPEND AS #1:LOCATE 10,20:PRINT "STREWING to ";F$;" ...  1";SPACE$(10):P=37+LEN(F$)
  214. 1920     J=I:X=SX-1:ON WHSTREW GOSUB 2000,5000
  215. 1930     FOR J=I+1 TO NUMENT
  216. 1940        X=INSTR(E$(FNE(J,1)),A$):IF X<1 THEN 1950
  217. 1942        IF X>1 THEN IF MID$(E$(FNE(J,1)),X-1,1)<>"," THEN 1950
  218. 1944        IF X+L<=LEN(E$(FNE(J,1))) THEN IF INSTR(" ,",MID$(E$(FNE(J,1)),X+L,1))=0 THEN 1950
  219. 1946          LOCATE 10,P:PRINT J;:ON WHSTREW GOSUB 2000,5000
  220. 1950     NEXT:CLOSE 1
  221. 1960     SX = LAS + 1
  222. 1970   GOTO 1840
  223. 1980 NEXT
  224. 1990 CLS:RETURN
  225. 2000 'PRINT ROUTINE
  226. 2010 PRINT #1,USING "\           \";E$(FNE(J,2));
  227. 2020 PRINT #1,USING "\        \";E$(FNE(J,5));
  228. 2030 PRINT #1,USING "\        \";E$(FNE(J,3));
  229. 2040 PRINT #1,E$(FNE(J,4)):RETURN
  230. 2050 NUMERIC=-1:X=1 'check a$ to see whether numeric
  231. 2060 IF MID$(A$,X,1)=SP$ THEN X=X+1:GOTO 2060 ELSE SX=X:X=LEN(A$)
  232. 2065 IF MID$(A$,X,1)=SP$ THEN X=X-1:GOTO 2065 ELSE LX=X
  233. 2070 IF LX<1 THEN 2090 ELSE XX=SX
  234. 2080 IF INSTR(DIGITS$,MID$(A$,XX,1)) THEN XX=XX+1:IF XX>LX THEN RETURN ELSE 2080
  235. 2090 NUMERIC=0:RETURN
  236. 2100 IX=1:FILEFOUND=-1:F1$=" :"+ZF$  'file search routine
  237. 2110 MID$(F1$,1,1)=MID$(ZDR$,IX,1):OPEN F1$ FOR INPUT AS #3
  238. 2120 RETURN
  239. 2130 'CONFIGURATION initialization
  240. 2132 LSET ZZ$="FILE to configure (no extension):":RO=1:GOSUB 860
  241. 2134 LOCATE RO,35:INPUT "",A$:IF A$=NUL$ THEN 300
  242. 2136 GOSUB 8000:SWAP A$,TOEDIT$:GOSUB 3950:IF DF$="RBBS.STW" THEN GOSUB 3200:GOTO 2166
  243. 2138 NAME DF$ AS DF$
  244. 2140 GOSUB 3400:GOTO 6000 'Entry when have gen strew config
  245. 2142 CLS:LOCATE 10,15:PRINT "Configuration file ";DF$;" not found";
  246. 2144 LSET ZZ$="CREATE new one BASED ON file (<rtn>=start from scratch):":RO=1:GOSUB 860:LOCATE RO,58:INPUT "",TF$:IF TF$=NUL$ THEN GOSUB 5900:GOTO 6000
  247. 2146 ORIG$=DF$:SWAP TF$,TOEDIT$:GOSUB 3950
  248. 2148 NAME DF$ AS DF$
  249. 2150 GOSUB 3400:SWAP ORIG$,DF$:GOTO 6000 'found config
  250. 2166 MAXFIELDS=2:NUMENT = NPARMS + 99 'Config for RBBS
  251. 2168 E$(FNE(1,2))= "Name of RBBS file to edit"
  252. 2170 E$(FNE(2,2))= "Drive containing RBBS directory files"
  253. 2172 E$(FNE(3,2))= "Drive(s) for RBBS uploaded files (ABCDE...)"
  254. 2180 E$(FNE(4,2))= "File to write skipped RBBS lines to"
  255. 2185 E$(FNE(5,2))= "Allow editing names of uploaded files (Y,N)"
  256. 2190 E$(FNE(6,2))= "Default directory # to be written to"
  257. 2200 E$(FNE(7,2))= "Maximum lines per screen (1-20)"
  258. 2210 E$(FNE(8,2))= "Maximum # of screens of data (1-20)"
  259. 2220 E$(FNE(9,2))= "Prefix of file to be written to"
  260. 2230 E$(FNE(10,2))= "Length of field identifying strew (1-13)"
  261. 2240 E$(FNE(11,2))= "Default mode in editing: R)eplace, I)nsert"
  262. 2250 FOR I = NPARMS + 1 TO NUMENT
  263. 2260    E$(FNE(I,2))="Help for directory "+MID$(STR$(I-NPARMS),2)
  264. 2270    E$(FNE(I,1))=DIRH$(I-NPARMS)
  265. 2280 NEXT
  266. 2290 E$(FNE(1,1))=TOEDIT$
  267. 2300 E$(FNE(2,1))=DR$
  268. 2310 E$(FNE(3,1))=UPDR$
  269. 2320 E$(FNE(4,1))=BADFILE$
  270. 2325 IF EDFILE THEN E$(FNE(5,1))="Y" ELSE E$(FNE(5,1))="N"
  271. 2330 E$(FNE(6,1))=D$
  272. 2340 E$(FNE(7,1))=MID$(STR$(MAXPERPAGE),2)
  273. 2350 E$(FNE(8,1))=MID$(STR$(MAXPAGE),2)
  274. 2360 E$(FNE(9,1))=PREFX$
  275. 2370 E$(FNE(10,1))=MID$(STR$(LSTREW),2)
  276. 2380 IF INSERTING THEN E$(FNE(11,1))="I" ELSE E$(FNE(11,1))="R"
  277. 2390 GOSUB 5800
  278. 2500 GOSUB 335:GOSUB 910
  279. 2510 GOSUB 5700
  280. 2520 ON INSTR("STE",A$) GOTO  2540,2530,2500
  281. 2530 GOSUB 2550:CLS:GOTO 300
  282. 2540 GOSUB 2550:GOTO 2650
  283. 2550 TOEDIT$ = E$(FNE(1,1)) 'after done editing
  284. 2560 DR$=E$(FNE(2,1))
  285. 2570 UPDR$=E$(FNE(3,1))
  286. 2580 BADFILE$ = E$(FNE(4,1))
  287. 2585 EDFILE$ = E$(FNE(5,1))
  288. 2590 D$=E$(FNE(6,1))
  289. 2600 MAXPERPAGE$ = E$(FNE(7,1))
  290. 2610 MAXPAGE$ = E$(FNE(8,1))
  291. 2620 PREFX$ = E$(FNE(9,1))
  292. 2630 LSTREW$ = E$(FNE(10,1))
  293. 2640 IR$ = E$(FNE(11,1)):GOSUB 2770:RETURN
  294. 2650 FOR I=NPARMS+1 TO NUMENT:DIRH$(I-NPARMS)=E$(FNE(I,1)):NEXT
  295. 2660 OPEN DF$ FOR OUTPUT AS #3
  296. 2670 PRINT #3,Q$;TOEDIT$;QCQ$;DR$;QCQ$;UPDR$;QCQ$;BADFILE$;QCQ$;EDFILE$;QCQ$;D$;QCQ$;MAXPERPAGE$;QCQ$;MAXPAGE$;
  297. 2680 PRINT #3,QCQ$;PREFX$;QCQ$;LSTREW$;QCQ$;IR$;Q$
  298. 2690 K=0:FOR I=1 TO 11:K=K+1:PRINT #3,Q$;DIRH$(K);
  299. 2700    FOR J=2 TO 9:K=K+1:PRINT #3,QCQ$;DIRH$(K);:NEXT:PRINT #3,Q$
  300. 2710 NEXT:CLOSE 3:CLS:GOTO 300
  301. 2720 'routine to set RBBS defaults if no default file
  302. 2730 FOR I=1 TO 99:DIRH$(I)="----------":NEXT
  303. 2740 TOEDIT$="DIR99":DR$="A":UPDR$="A":BADFILE$="SKIPPED.LNS":D$="1":MAXPERPAGE$="20"
  304. 2750 MAXPAGE$="20":PREFX$="DIR":LSTREW$="8":IR$="R":EDFILE$="N"
  305. 2760 GOSUB 2770:RETURN
  306. 2762 A$=MAXPERPAGE$:MN=MINMPP:MX=20:RX=6:GOSUB 2870:MAXPERPAGE = X
  307. 2764 A$=MAXPAGE$:MN=1:MX=90:RX=8:GOSUB 2870:MAXPAGE = X
  308. 2766 A$=LSTREW$:MN=1:MX=13:RX=10:GOSUB 2870:LSTREW = X:RETURN
  309. 2770 IF IR$=NUL$ OR INSTR("RrIi",IR$)<3 THEN INSERTING = 0 ELSE INSERTING = -1
  310. 2775 IF INSTR("NnYy",MID$(EDFILE$,1,1))<3 THEN EDFILE=0 ELSE EDFILE=-1
  311. 2780 Z$=NUL$:GOSUB 2762
  312. 2810 IF Z$<>NUL$ THEN Z$="INVALID entries: "+Z$:RO=25:LSET ZZ$=Z$:GOSUB 860:R=RXX+FIRSTROW-1:PO=1:RETURN 2500
  313. 2820 IF DR$<>NUL$ AND MID$(PREFX$,2,1)<>":" THEN PRE$=DR$+":"+PREFX$ ELSE PRE$=PREFX$
  314. 2830 LASTROW = FIRSTROW + MAXPERPAGE - 1
  315. 2840 'IF MAXPERPAGE THEN MAXENTRIES = MAXPAGE*MAXPERPAGE ELSE MAXENTRIES = MAXENTDIM
  316. 2845 'IF MAXENTRIES > MAXENTDIM THEN MAXENTRIES = MAXENTDIM
  317. 2850 ' IF MAXENTRIES < NPARMS+99 THEN X=NPARMS+99 ELSE X=MAXENTRIES
  318. 2860 RETURN
  319. 2870 GOSUB 2050:IF NOT NUMERIC THEN X=0:GOSUB 2900:RETURN
  320. 2880 X=VAL(A$):IF X<MN OR X>MX THEN GOSUB 2900:RETURN
  321. 2890 RETURN
  322. 2900 Z$=Z$+"  >>"+A$+"<<":RXX=RX:RETURN
  323. 3000 DONE!=FNSECONDS!+PAUSE! 'pause routine based on clock
  324. 3010 IF FNSECONDS!<DONE! THEN 3010
  325. 3020 RETURN
  326. 3100 NFS = LEN(FLDSEP$)
  327. 3110 IF INSTR("NnYy",MID$(READSTREW$,1,1))>2 THEN INC=0:MAXEDIT=0 ELSE INC=1:MAXEDIT=1:CTITLE$(1)=MID$("STREW TO",1,LSTREW):MAX(1)=LSTREW:EFLDS(1)=1
  328. 3120 IF INSTR("FfVv",MID$(FIXEDLENGTH$,1,1))>2 THEN FIXEDLENGTH=0 ELSE FIXEDLENGTH=-1
  329. 3130 MAXFIELDS=NCOL+INC:GOSUB 8100:RETURN
  330. 3200 CLS 'Read RBBS configuration
  331. 3210 NORBBS = 0: DF$ = "RBBS.STW": CONSTREW$ = "RBBS":TOEDIT$=CONSTREW$
  332. 3220 NAME DF$ AS DF$
  333. 3240 LOCATE 12,15:PRINT "READING Configuration from ";DF$; 'entry if got default file
  334. 3250 OPEN DF$ FOR INPUT AS #1
  335. 3260 INPUT #1,TOEDIT$,DR$,UPDR$,BADFILE$,EDFILE$,D$,MAXPERPAGE$,MAXPAGE$,PREFX$,LSTREW$,IR$
  336. 3270 FOR I=1 TO 99:INPUT #1,DIRH$(I):NEXT
  337. 3280 CLOSE 1:FLDSEP$=NUL$:RECSEP$=CR$+LF$
  338. 3390 GOSUB 2770:RETURN 'process strings read in
  339. 3400 OPEN DF$ FOR INPUT AS #1 'Get general strew configuration
  340. 3405 LOCATE 10,5:PRINT "Reading Configuration File ";DF$;" ... ":P=37+LEN(DF$)
  341. 3410 INPUT #1,NCOL$,D$,MAXPERPAGE$,MAXPAGE$,PREFX$,LSTREW$,READSTREW$,FIXEDLENGTH$,FLDSEP$,RECSEP$:GOSUB 4900
  342. 3415 gosub 3100:XT=MAXFIELDS:MAXFIELDS=7:A$=SPACE$(5):NWRITE=0
  343. 3450 FOR I=1 TO NCOL
  344. 3460   W=FNE(I,1):INPUT #1,E$(W),E$(W+1),E$(W+2),E$(W+3),E$(W+4),E$(W+5),E$(W+6)
  345. 3470   GOSUB 3500:LOCATE 10,P:PRINT I;
  346. 3480 NEXT:CLOSE #1:MAXFIELDS=XT:CONSTREW$=MID$(DF$,1,INSTR(DF$,".")-1):RETURN
  347. 3500 'Process general strew configuration entry
  348. 3510 IX = I+INC:W=FNE(I,1)
  349. 3515 CTITLE$(IX)=E$(W)
  350. 3520 LSET A$=E$(W+1):MN=1:MX=80:GOSUB 2870:MAX(IX)=X
  351. 3530 LSET A$=E$(W+3):MN=1:MX=32000:GOSUB 2870:RCOL(I)=X
  352. 3540 LSET A$=E$(W+4):MN=1:MX=255:GOSUB 2870:RLEN(I)=X
  353. 3550 LSET A$=E$(W+5):MN=0:MX=NCOL:GOSUB 2870:IF X>0 THEN NWRITE=NWRITE+1:WORDER(NWRITE)=I
  354. 3560 IF INSTR("NnYy",MID$(E$(W+2),1,1))>2 THEN MAXEDIT=MAXEDIT+1:EFLDS(MAXEDIT)=IX
  355. 3570 IF INSTR("NnYy",MID$(E$(W+6),1,1))>2 THEN NQUO(I)=-1 ELSE NQUO(I)=0
  356. 3580 RETURN
  357. 3950 DF$=MID$(TOEDIT$,1,INSTR(TOEDIT$+".",".")-1)+".STW":RETURN
  358. 4000 WHSTREW = 2:MINMPP=0:NORBBS=-1 'General Strew Routine
  359. 4005 IF PARM$<>NUL$ THEN A$=PARM$:PARM$=NUL$:GOTO 4020
  360. 4010 LSET ZZ$="File to strew:":RO=1:GOSUB 860:LOCATE RO,16:INPUT "",A$:IF A$=NUL$ THEN 300 ELSE GOSUB 8000
  361. 4020 SWAP A$,TOEDIT$:GOSUB 3950:IF CONSTREW$<>MID$(DF$,1,INSTR(DF$+".",".")-1) THEN GOSUB 3400 ELSE XT=MAXFIELDS:GOSUB 3100:SWAP XT,MAXFIELDS:FOR I=1 TO NCOL:IX=I+INC:W=FNE(I,1):GOSUB 3560:NEXT:SWAP XT,MAXFIELDS
  362. 4200 MOREITEMS=-1:LO(1)=43:HI(1)=123
  363. 4210 FOR I=2 TO MAXFIELDS:LO(I)=14:HI(I)=255:NEXT
  364. 4220 STRT(1)=0:GOSUB 4950
  365. 4230 GOSUB 4800
  366. 4240 OPEN TOEDIT$ FOR INPUT AS #2:CLOSE 2 'Check file existence
  367. 4245 OPEN TOEDIT$ FOR APPEND AS #2:CLOSE 2 'Ensure that file ends with ctrl-z (compiled vers needs this)
  368. 4247 OPEN TOEDIT$ FOR INPUT AS #2:NREADS=0:GOSUB 4500
  369. 4250 IF MAXPERPAGE=0 THEN A$="S":GOTO 4270 ELSE GOSUB 335:GOSUB 910
  370. 4260 LSET ZZ$="S)trew...A)bort...E)dit again...([S],A,E)":RO=1:GOSUB 860:LOCATE RO,43:INPUT "",A$:GOSUB 8000
  371. 4270 ON INSTR("SAE",A$) GOTO 4280,300,4250
  372. 4275 IF QPARM THEN 330 ELSE 620
  373. 4280 GOSUB 1790:IF NOT MOREITEMS THEN 4275
  374. 4290 GOSUB 4500: IF NUMENT < 1 THEN 4275 ELSE 4250
  375. 4500 PREVSCRN=0:PREVPAGE=0 'General Read Routine
  376. 4520 GOSUB 4700:A$=SP$
  377. 4530 IF EOF(2) THEN CLOSE 2:MOREITEMS=0:LSET ZZ$="All"+str$(NREADS)+" lines in "+TOEDIT$+" read.":RO=25:GOSUB 860:GOTO 820
  378. 4540 IF NUMENT >= MAXENTRIES THEN LSET ZZ$="NOT ALL items have been read from "+TOEDIT$:RO=25:GOSUB 860:GOTO 820
  379. 4550 NUMENT=NUMENT+1:P=1:NREADS=NREADS+1:LOCATE 12,32:PRINT NREADS;
  380. 4555 E$(FNE(NUMENT,1))=D$
  381. 4560 FOR IX=1 TO NCOL
  382. 4570   I=RORDER(IX):IF P>=RCOL(I) THEN 4600
  383. 4580   X=RCOL(I)-P:IF X>255 THEN LSET A$=INPUT$(255,2):P=P+255:GOTO 4580 ELSE LSET A$=INPUT$(X,2):P=RCOL(I)
  384. 4600   E$(FNE(NUMENT,I+INC))=MID$(INPUT$(RLEN(I),2),1,MAX(I+INC))
  385. 4610   P=P+RLEN(I)
  386. 4620 NEXT
  387. 4630 IF EOF(2) THEN 4530 ELSE LSET A$=INPUT$(1,2):IF A$<>CR$ THEN 4630 ELSE IF EOF(2) THEN 4530 ELSE LSET A$=INPUT$(1,2):GOTO 4530
  388. 4700 CLS:LOCATE 10,25:PRINT "Reading ";TOEDIT$;
  389. 4710 LOCATE 12,25:PRINT "Record ";
  390. 4720 NUMENT = 0:RETURN
  391. 4800 FOR I=1 TO NCOL:RORDER(I)=I:NEXT
  392. 4810 FOR I=1 TO NCOL-1
  393. 4820   FOR J=I+1 TO NCOL
  394. 4830     IF RCOL(RORDER(J-1))>RCOL(RORDER(J)) THEN SWAP RORDER(J-1),RORDER(J)
  395. 4840 NEXT:NEXT:RETURN
  396. 4900 GOSUB 2780
  397. 4910 A$=NCOL$:MN=1:MX=MAXDIM:GOSUB 2870:NCOL=X
  398. 4920 RETURN
  399. 4950 LASTSCRN=1:FIRSTFLD(1)=1:FLD2SCRN(1)=1
  400. 4960 FOR I=2 TO MAXFIELDS
  401. 4965   X=STRT(I-1) + MAX(I-1) + 2
  402. 4970   IF X+MAX(I)>80 THEN LASTSCRN=LASTSCRN+1:X=1:FIRSTFLD(LASTSCRN)=I
  403. 4975   FLD2SCRN(I)=LASTSCRN
  404. 4980   STRT(I)=X
  405. 4990 NEXT:FIRSTFLD(LASTSCRN+1)=MAXFIELDS+1:RETURN
  406. 5000 IF NWRITE<1 THEN RETURN  ' General save routine
  407. 5005 Y = WORDER(1):X=Y+INC
  408. 5010 IF FIXEDLENGTH THEN 5080
  409. 5020 'Variable length processing
  410. 5030 IF NQUO(Y) THEN PRINT #1,Q$;E$(FNE(J,X));Q$; ELSE PRINT #1,E$(FNE(J,X));
  411. 5040 FOR IX=2 TO NWRITE
  412. 5050   Y = WORDER(IX):X=Y+INC
  413. 5060   IF NQUO(Y) THEN PRINT #1,FLDSEP$;Q$;E$(FNE(J,X));Q$; ELSE PRINT #1,FLDSEP$;E$(FNE(J,X));
  414. 5070 NEXT:GOTO 5150
  415. 5080 'Fixed length processing
  416. 5090 IF NQUO(Y) THEN PRINT #1,Q$;E$(FNE(J,X));SPACE$(MAX(X)-LEN(E$(FNE(J,X))));Q$; ELSE PRINT #1,E$(FNE(J,X));SPACE$(MAX(X)-LEN(E$(FNE(J,X))));
  417. 5100 FOR IX=2 TO NWRITE
  418. 5110   Y = WORDER(IX):X= Y+INC
  419. 5120   IF NQUO(Y) THEN PRINT #1,FLDSEP$;Q$;E$(FNE(J,X));SPACE$(MAX(X)-LEN(E$(FNE(J,X))));Q$; ELSE PRINT #1,FLDSEP$;E$(FNE(J,X));SPACE$(MAX(X)-LEN(E$(FNE(J,X))));
  420. 5130 NEXT
  421. 5140 ' PRINT "PRINTED REC ";J:INPUT XX$
  422. 5150 PRINT #1,RECSEP$;:RETURN
  423. 5600 'save,restore overlap
  424. 5610 SWAP CTITLE$(1),E$(1799):SWAP CTITLE$(2),E$(1800)
  425. 5620 SWAP MAX(1),TEMP(3):SWAP MAX(2),TEMP(4)
  426. 5630 SWAP EFLDS(1),TEMP(1):SWAP EFLDS(2),TEMP(2)
  427. 5640 SWAP MAXEDIT,MXE
  428. 5650 RETURN
  429. 5700 LSET ZZ$="Configure - S)ave...T)emporary only...E)dit again ([S],T,E)":RO=1:GOSUB 860:LOCATE RO,61:INPUT "",A$:GOSUB 8000:RETURN
  430. 5800 MAXFIELDS = 2:GOSUB 8100 'Shared routine in config
  431. 5805 FOR I=1 TO MAXFIELDS:FLD2SCRN(I)=1:NEXT:FIRSTFLD(1)=1:FIRSTFLD(2)=MAXFIELDS+1:LASTSCRN=1
  432. 5810 MOREITEMS = 0
  433. 5820 CTITLE$(1)=" VALUE":CTITLE$(2)="  PARAMETER"
  434. 5830 LO(1) = 31
  435. 5840 HI(1) = 127
  436. 5850 STRT(1) = 3:STRT(2) = 19
  437. 5860 MAX(1) = 14:MAX(2) = 41
  438. 5870 MAXEDIT = 1
  439. 5880 EFLDS(1) = 1
  440. 5890 PREVPAGE=-1:GOSUB 820:RETURN
  441. 5900 'Default general strew config
  442. 5910 NCOL=1:D$="1":MAXPERPAGE=20:MAXPAGE=MAXMAX\MAXPERPAGE
  443. 5920 PREFX$="STRU":LSTREW=8:READSTREW$="N":FIXEDLENGTH=-1:FIXEDLENGTH$="F"
  444. 5930 FLDSEP$=NUL$:RECSEP$=CR$+LF$:NFS=LEN(FLDSEP$):MAX(1)=LSTREW:MAX(2)=10
  445. 5932 CTITLE$(1)="STREW TO":CTITLE$(2)="F1":MAXEDIT=2:EFLDS(1)=1:EFLDS(2)=2
  446. 5934 NQUO(1)=0:WORDER(1)=1:RCOL(1)=1:RLEN(1)=10:INC=1
  447. 5940 RETURN
  448. 5950 MAXPERPAGE$=E$(FNE(3,1)):MAXPAGE$=E$(FNE(4,1)):LSTREW$=E$(FNE(6,1))
  449. 5955 Z$=NUL$:NCOL$=E$(FNE(1,1)):A$=NCOL$:MN=1:MX=MAXDIM:GOSUB 2870:NCOL=X
  450. 5960 GOSUB 2762
  451. 5970 IF Z$<>NUL$ THEN Z$="INVALID entries: "+Z$:RO=25:LSET ZZ$=Z$:GOSUB 860:R=RXX+FIRSTROW-1:PO=1:RETURN 6200
  452. 5980 MP=20:SWAP MP,MAXPERPAGE:RETURN
  453. 6000 MAXFIELDS=2:GOSUB 8100 'General strew configure
  454. 6010 E$(FNE(1,2))="Number of columns of data to read (1-99)"
  455. 6020 E$(FNE(2,2))="Default suffix of file to strew to"
  456. 6030 E$(FNE(3,2))="Maximum lines per screen (0-20,0=don't see))"
  457. 6040 E$(FNE(4,2))="Maximum # of screens of data"
  458. 6050 E$(FNE(5,2))="Prefix of files to strew to"
  459. 6060 E$(FNE(6,2))="Length of field identifying strew"
  460. 6070 E$(FNE(7,2))="Read strew field from file (Y,N)?"
  461. 6080 E$(FNE(8,2))="Output file is F)ixed...V)ariable length (F,V)"
  462. 6100 NUMENT = 8:PCOL=NCOL
  463. 6110 E$(FNE(1,1))=FNNSTR$(NCOL)
  464. 6120 E$(FNE(2,1))=D$
  465. 6130 E$(FNE(3,1))=FNNSTR$(MAXPERPAGE):MAXPERPAGE=20
  466. 6140 E$(FNE(4,1))=FNNSTR$(MAXPAGE)
  467. 6150 E$(FNE(5,1))=PREFX$
  468. 6160 E$(FNE(6,1))=FNNSTR$(LSTREW)
  469. 6170 E$(FNE(7,1))=READSTREW$
  470. 6180 IF FIXEDLENGTH THEN E$(FNE(8,1))="F" ELSE E$(FNE(8,1))="V"
  471. 6190 GOSUB 5600:GOSUB 5800
  472. 6200 GOSUB 335:GOSUB 910
  473. 6210 GOSUB 5950:LSET ZZ$="FIELD  separator:":SEP$=FLDSEP$
  474. 6220 RO=FIRSTROW+NUMENT+1:GOSUB 860:GOSUB 6800:FLDSEP$=SEP$
  475. 6230 LSET ZZ$="RECORD separator:":SEP$=RECSEP$
  476. 6240 RO=FIRSTROW+NUMENT+2:GOSUB 860:GOSUB 6800:RECSEP$=SEP$
  477. 6270 GOSUB 5700
  478. 6280 ON INSTR("STE",A$) GOTO  6300,6300,6200
  479. 6300 D$=E$(FNE(2,1)):PREFX$=E$(FNE(5,1)):IF INSTR("Ff",MID$(E$(FNE(8,1)),1,1))>0 THEN LSET FIXEDLENGTH$="F" ELSE LSET FIXEDLENGTH$="V"
  480. 6304 READSTREW$=E$(FNE(7,1)):GOSUB 5600:NUMENT=NCOL:MAXFIELDS=7:GOSUB 8100
  481. 6306 IF NCOL>PCOL THEN FOR I=PCOL+1 TO NCOL:CTITLE$(I+INC)="F"+FNNSTR$(I):NQUO(I)=0:WORDER(I)=I:NEXT
  482. 6308 FOR I=1 TO NCOL
  483. 6310   E$(FNE(I,1))=CTITLE$(I+INC)
  484. 6313   E$(FNE(I,2))=FNNSTR$(MAX(I+INC))
  485. 6316   E$(FNE(I,3))="Y"
  486. 6319   E$(FNE(I,4))=FNNSTR$(RCOL(I))
  487. 6322   E$(FNE(I,5))=FNNSTR$(RLEN(I))
  488. 6325   IF WORDER(I)>0 THEN E$(FNE(WORDER(I),6))=FNNSTR$(I) ELSE E$(FNE(I,6))="0"
  489. 6328   IF NQUO(I) THEN E$(FNE(I,7))="Y" ELSE E$(FNE(I,7))="N"
  490. 6331 NEXT
  491. 6334 FOR I=1+INC TO MAXEDIT:E$(FNE(EFLDS(I)-INC,3))="Y":NEXT
  492. 6337 CTITLE$(1)="TITLE     ":CTITLE$(2)="WIDTH":CTITLE$(3)="EDIT?"
  493. 6340 CTITLE$(4)="STARTS AT":CTITLE$(5)="# CHARS":CTITLE$(6)="ORDER OUT":CTITLE$(7)="QUOTES?"
  494. 6343 FOR I=1 TO MAXFIELDS:MAX(I)=LEN(CTITLE$(I)):EFLDS(I)=I:NEXT
  495. 6346 MAXEDIT=MAXFIELDS:STRT(1)=0:GOSUB 4950
  496. 6350 LO(2)=32:HI(2)=58
  497. 6360 LO(4)=32:HI(4)=58
  498. 6370 LO(5)=32:HI(5)=58
  499. 6380 LO(6)=32:HI(6)=58
  500. 6390 LO(3)=77:HI(3)=122
  501. 6400 LO(7)=77:HI(7)=122
  502. 6410 LO(1)=31:HI(1)=123
  503. 6420 GOSUB 2820:PREVPAGE=0:PREVSCRN=0:GOSUB 820
  504. 6430 GOSUB 335:GOSUB 910
  505. 6440 GOSUB 5700
  506. 6450 ON INSTR("STE",A$) GOTO 6470,6460,6430
  507. 6460 GOSUB 6500:GOTO 300
  508. 6470 GOSUB 6500:GOSUB 6600:GOTO 300
  509. 6500 'after edit
  510. 6510 MAXEDIT=0:Z$=NUL$:A$=SPACE$(5):NWRITE=0
  511. 6520 FOR I=1 TO NCOL:GOSUB 3500:NEXT
  512. 6530 IF Z$<>NUL$ THEN Z$="INVALID entries: "+Z$:RO=25:LSET ZZ$=Z$:GOSUB 860:R=RXX+FIRSTROW-1:PO=1:RETURN 6430
  513. 6540 MAXPERPAGE=MP:CLS:RETURN
  514. 6600 LOCATE 10,10:PRINT "SAVING Configuration to ";DF$; 'save general strew config
  515. 6610 OPEN DF$ FOR OUTPUT AS #3:CONSTREW$=MID$(DF$,1,INSTR(DF$,".")-1)
  516. 6620 PRINT #3,Q$;NCOL$;QCQ$;D$;QCQ$;MAXPERPAGE$;QCQ$;MAXPAGE$;QCQ$;PREFX$;QCQ$;LSTREW$;QCQ$;READSTREW$;QCQ$;FIXEDLENGTH$;
  517. 6630 PRINT #3,QCQ$;FLDSEP$;QCQ$;RECSEP$;Q$
  518. 6640 FOR I=1 TO NCOL
  519. 6650    PRINT #3,Q$;E$(FNE(I,1));:FOR J=2 TO 7:PRINT #3,QCQ$;E$(FNE(I,J));:NEXT:PRINT #3,Q$
  520. 6660 NEXT:CLOSE 3:RETURN
  521. 6700 LOCATE 18,10:PRINT "Enter character";I;" in separator: ";:LOCATE 18,POS(0),1,6,7:A$=INPUT$(1):SEP$=SEP$+A$
  522. 6710 LOCATE RO,P:IF A$ = CR$ THEN P$="<CR>" ELSE IF A$=LF$ THEN P$="<LF>" ELSE IF A$=SP$ THEN P$="<sp>" ELSE P$=A$
  523. 6720 PRINT P$;:P=P+LEN(P$):RETURN
  524. 6800 P=19:IF SEP$=NUL$ THEN LOCATE RO,P:PRINT "<none>";:GOTO 6820 'Process field & record separators
  525. 6810 FOR I=1 TO LEN(SEP$):A$=MID$(SEP$,I,1):GOSUB 6710:NEXT
  526. 6820 INPUT "    Change separator (Y,[N])? ",A$:IF INSTR("NnYy",A$)<3 THEN RETURN
  527. 6830 XY=RO:RO=17:LSET ZZ$="Enter number of characters in separator: ":GOSUB 860
  528. 6840 LOCATE RO,42:INPUT "",A$:GOSUB 2050:IF NOT NUMERIC THEN BEEP:GOTO 6840
  529. 6850 NFS=VAL(A$):P=19:RO=XY:SEP$=NUL$:LOCATE RO,P:PRINT SPACE$(79-P);
  530. 6860 FOR I=1 TO NFS:GOSUB 6700:NEXT
  531. 6870 RETURN
  532. 8000 'convert a$ to upper case
  533. 8010 FOR I=1 TO LEN(A$):MID$(A$,I,1)=CHR$( ASC(MID$(A$,I,1)) + 32*(ASC(MID$(A$,I,1))>96) ):NEXT:RETURN
  534. 8100 MAXENTRIES = MAXMAX \ MAXFIELDS:RETURN
  535. 9000 '  GETS DOS PASSED PARAMETER
  536. 9010 DEF SEG:DIM SUBR%(3):DEF USR0=VARPTR(SUBR%(0))
  537. 9020 SUBR%(0)=&H5B59:SUBR%(1)=&H5153:SUBR%(2)=&HEB83:SUBR%(3)=&HCB10
  538. 9030 I%=0:PSP%=USR0(I%):DEF SEG=PSP%:PARMLEN%=PEEK(&H80):PARM$=NUL$:A$=NUL$
  539. 9035 IF PARMLEN%<1 THEN 9060
  540. 9040 FOR I% = 2 TO PARMLEN%:A$=A$+CHR$(PEEK(&H80+I%)):NEXT I%
  541. 9050 GOSUB 8000:IF RIGHT$(A$,2)=" Q" THEN QPARM=-1:A$=MID$(A$,1,LEN(A$)-2) ELSE QPARM=0
  542. 9055 IF A$=SPACE$(LEN(A$)) THEN A$=NUL$
  543. 9060 RETURN
  544. 10000 'ERROR processing
  545. 10020 IF ERL=3220 THEN IF ERR=58 THEN RESUME 3240 ELSE IF ERR=53 THEN GOSUB 10950:IF X=1 THEN GOSUB 2720:RESUME 2166 ELSE RESUME 300
  546. 10040 IF ERL=560 THEN IF ERR=53 THEN GOSUB 10900:IF TOEDIT$<>NUL$ THEN RESUME 540 ELSE resume 300
  547. 10060 IF ERL=2110 THEN IF ERR=53 THEN IF IX<LEN(ZDR$) THEN IX=IX+1:RESUME 2110 ELSE FILEFOUND=0:RESUME 2120
  548. 10065 IF ERL=2138 THEN IF ERR=58 THEN RESUME 2140 ELSE IF ERR=53 THEN RESUME 2142
  549. 10070 IF ERL=2148 THEN IF ERR=58 THEN RESUME 2150 ELSE IF ERR=53 THEN RESUME 2142
  550. 10072 IF ERL=3400 AND ERR=53 THEN GOSUB 10950:IF X=1 THEN RESUME 2144 ELSE RESUME 300
  551. 10073 IF ERL=3400 AND ERR=52 THEN A$=DF$:GOSUB 10980:DF$=A$:RESUME 3400
  552. 10075 IF ERL=4240 THEN IF ERR=53 THEN GOSUB 10900:IF TOEDIT$<>NUL$ THEN RESUME 4240 ELSE RESUME 300
  553. 10077 IF ERL=4240 AND ERR=52 THEN A$=TOEDIT$:GOSUB 10980:TOEDIT$=A$:RESUME 4240
  554. 10080 CLS:PRINT "Unexpected error # ";ERR;" occurred on line ";ERL;"."
  555. 10100 GOSUB 1590:GOTO 330
  556. 10900 LSET ZZ$="Missing file "+TOEDIT$:RO=1:GOSUB 860:LOCATE RO,30:INPUT "<rtn> to quit, or enter name: ",TOEDIT$:CLS:RETURN
  557. 10950 LOCATE 8,10:PRINT "NO CONFIGURATION exists for ";TOEDIT$;
  558. 10960 RO=1:LSET ZZ$="C)reate one...A)bort ([C],A):":GOSUB 860:LOCATE RO,35:INPUT "",A$:GOSUB 8000
  559. 10970 X=INSTR("CA",A$):IF X<1 THEN BEEP:GOTO 10960 ELSE RETURN
  560. 10980 LSET ZZ$="Invalid filename: "+A$:RO=1:GOSUB 860:LOCATE RO,30:INPUT "<rtn> to quit, or enter name: ",A$:CLS:IF A$=NUL$ then RESUME 300 ELSE RETURN
  561.